home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / guile / 1.8 / ice-9 / streams.scm < prev    next >
Encoding:
Text File  |  2008-12-17  |  7.3 KB  |  218 lines
  1. ;;;; streams.scm --- general lazy streams
  2. ;;;; -*- Scheme -*-
  3.  
  4. ;;;; Copyright (C) 1999, 2001, 2004, 2006 Free Software Foundation, Inc.
  5. ;;;; 
  6. ;;;; This library is free software; you can redistribute it and/or
  7. ;;;; modify it under the terms of the GNU Lesser General Public
  8. ;;;; License as published by the Free Software Foundation; either
  9. ;;;; version 2.1 of the License, or (at your option) any later version.
  10. ;;;; 
  11. ;;;; This library is distributed in the hope that it will be useful,
  12. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14. ;;;; Lesser General Public License for more details.
  15. ;;;; 
  16. ;;;; You should have received a copy of the GNU Lesser General Public
  17. ;;;; License along with this library; if not, write to the Free Software
  18. ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19.  
  20. ;; the basic stream operations are inspired by
  21. ;; (i.e. ripped off) Scheme48's `stream' package,
  22. ;; modulo stream-empty? -> stream-null? renaming.
  23.  
  24. (define-module (ice-9 streams)
  25.   :export (make-stream
  26.        stream-car stream-cdr stream-null?
  27.        list->stream vector->stream port->stream
  28.        stream->list stream->reversed-list
  29.        stream->list&length stream->reversed-list&length
  30.        stream->vector
  31.        stream-fold stream-for-each stream-map))
  32.  
  33. ;; Use:
  34. ;;
  35. ;; (make-stream producer initial-state)
  36. ;;  - PRODUCER is a function of one argument, the current state.
  37. ;;    it should return either a pair or an atom (i.e. anything that
  38. ;;    is not a pair).  if PRODUCER returns a pair, then the car of the pair
  39. ;;    is the stream's head value, and the cdr is the state to be fed
  40. ;;    to PRODUCER later.  if PRODUCER returns an atom, then the stream is
  41. ;;    considered depleted.
  42. ;;
  43. ;; (stream-car stream)
  44. ;; (stream-cdr stream)
  45. ;; (stream-null? stream)
  46. ;;  - yes.
  47. ;;
  48. ;; (list->stream list)
  49. ;; (vector->stream vector)
  50. ;;  - make a stream with the same contents as LIST/VECTOR.
  51. ;;
  52. ;; (port->stream port read)
  53. ;;  - makes a stream of values which are obtained by READing from PORT.
  54. ;;
  55. ;; (stream->list stream)
  56. ;;  - returns a list with the same contents as STREAM.
  57. ;;
  58. ;; (stream->reversed-list stream)
  59. ;;  - as above, except the contents are in reversed order.
  60. ;;
  61. ;; (stream->list&length stream)
  62. ;; (stream->reversed-list&length stream)
  63. ;;  - multiple-valued versions of the above two, the second value is the
  64. ;;    length of the resulting list (so you get it for free).
  65. ;;
  66. ;; (stream->vector stream)
  67. ;;  - yes.
  68. ;;
  69. ;; (stream-fold proc init stream0 ...)
  70. ;;  - PROC must take (+ 1 <number-of-stream-arguments>) arguments, like this:
  71. ;;    (PROC car0 ... init).  *NOTE*: the INIT argument is last, not first.
  72. ;;    I don't have any preference either way, but it's consistent with
  73. ;;    `fold[lr]' procedures from SRFI-1.  PROC is applied to successive
  74. ;;    elements of the given STREAM(s) and to the value of the previous
  75. ;;    invocation (INIT on the first invocation).  the last result from PROC
  76. ;;    is returned.
  77. ;;
  78. ;; (stream-for-each proc stream0 ...)
  79. ;;  - like `for-each' we all know and love.
  80. ;;
  81. ;; (stream-map proc stream0 ...)
  82. ;;  - like `map', except returns a stream of results, and not a list.
  83.  
  84. ;; Code:
  85.  
  86. (define (make-stream m state)
  87.   (delay
  88.     (let ((o (m state)))
  89.       (if (pair? o)
  90.       (cons (car o)
  91.         (make-stream m (cdr o)))
  92.           '()))))
  93.  
  94. (define (stream-car stream)
  95.   "Returns the first element in STREAM.  This is equivalent to `car'."
  96.   (car (force stream)))
  97.  
  98. (define (stream-cdr stream)
  99.   "Returns the first tail of STREAM. Equivalent to `(force (cdr STREAM))'."
  100.   (cdr (force stream)))
  101.  
  102. (define (stream-null? stream)
  103.   "Returns `#t' if STREAM is the end-of-stream marker; otherwise
  104. returns `#f'.  This is equivalent to `null?', but should be used
  105. whenever testing for the end of a stream."
  106.   (null? (force stream)))
  107.  
  108. (define (list->stream l)
  109.   "Returns a newly allocated stream whose elements are the elements of
  110. LIST.  Equivalent to `(apply stream LIST)'."
  111.   (make-stream
  112.    (lambda (l) l)
  113.    l))
  114.  
  115. (define (vector->stream v)
  116.   (make-stream
  117.    (let ((len (vector-length v)))
  118.      (lambda (i)
  119.        (or (= i len)
  120.            (cons (vector-ref v i) (+ 1 i)))))
  121.    0))
  122.  
  123. (define (stream->reversed-list&length stream)
  124.   (let loop ((s stream) (acc '()) (len 0))
  125.     (if (stream-null? s)
  126.         (values acc len)
  127.         (loop (stream-cdr s) (cons (stream-car s) acc) (+ 1 len)))))
  128.  
  129. (define (stream->reversed-list stream)
  130.   (call-with-values
  131.    (lambda () (stream->reversed-list&length stream))
  132.    (lambda (l len) l)))
  133.  
  134. (define (stream->list&length stream)
  135.   (call-with-values
  136.    (lambda () (stream->reversed-list&length stream))
  137.    (lambda (l len) (values (reverse! l) len))))
  138.  
  139. (define (stream->list stream)
  140.   "Returns a newly allocated list whose elements are the elements of STREAM.
  141. If STREAM has infinite length this procedure will not terminate."
  142.   (reverse! (stream->reversed-list stream)))
  143.  
  144. (define (stream->vector stream)
  145.   (call-with-values
  146.    (lambda () (stream->reversed-list&length stream))
  147.    (lambda (l len)
  148.      (let ((v (make-vector len)))
  149.        (let loop ((i 0) (l l))
  150.          (if (not (null? l))
  151.              (begin
  152.                (vector-set! v (- len i 1) (car l))
  153.                (loop (+ 1 i) (cdr l)))))
  154.        v))))
  155.  
  156. (define (stream-fold f init stream . rest)
  157.   (if (null? rest) ;fast path
  158.       (stream-fold-one f init stream)
  159.       (stream-fold-many f init (cons stream rest))))
  160.  
  161. (define (stream-fold-one f r stream)
  162.   (if (stream-null? stream)
  163.       r
  164.       (stream-fold-one f (f (stream-car stream) r) (stream-cdr stream))))
  165.  
  166. (define (stream-fold-many f r streams)
  167.   (if (or-map stream-null? streams)
  168.       r
  169.       (stream-fold-many f
  170.                         (apply f (let recur ((cars
  171.                                               (map stream-car streams)))
  172.                                    (if (null? cars)
  173.                                        (list r)
  174.                                        (cons (car cars)
  175.                                              (recur (cdr cars))))))
  176.                         (map stream-cdr streams))))
  177.  
  178. (define (stream-for-each f stream . rest)
  179.   (if (null? rest) ;fast path
  180.       (stream-for-each-one f stream)
  181.       (stream-for-each-many f (cons stream rest))))
  182.  
  183. (define (stream-for-each-one f stream)
  184.   (if (not (stream-null? stream))
  185.       (begin
  186.         (f (stream-car stream))
  187.         (stream-for-each-one f (stream-cdr stream)))))
  188.  
  189. (define (stream-for-each-many f streams)
  190.   (if (not (or-map stream-null? streams))
  191.       (begin
  192.         (apply f (map stream-car streams))
  193.         (stream-for-each-many f (map stream-cdr streams)))))
  194.  
  195. (define (stream-map f stream . rest)
  196.   "Returns a newly allocated stream, each element being the result of
  197. invoking F with the corresponding elements of the STREAMs
  198. as its arguments."
  199.   (if (null? rest) ;fast path
  200.       (make-stream (lambda (s)
  201.                      (or (stream-null? s)
  202.                          (cons (f (stream-car s)) (stream-cdr s))))
  203.                    stream)
  204.       (make-stream (lambda (streams)
  205.                      (or (or-map stream-null? streams)
  206.                          (cons (apply f (map stream-car streams))
  207.                                (map stream-cdr streams))))
  208.                    (cons stream rest))))
  209.  
  210. (define (port->stream port read)
  211.   (make-stream (lambda (p)
  212.                  (let ((o (read p)))
  213.                    (or (eof-object? o)
  214.                        (cons o p))))
  215.                port))
  216.  
  217. ;;; streams.scm ends here
  218.